-- card: 18192 from stack: in.3 -- bmap block id: 0 -- flags: 4000 -- background id: 3241 -- name: Password ----- HyperTalk script ----- on Install get ChooseTargetStack() InstallResource XFCN,Password,it end Install -- part 1 (button) -- low flags: 00 -- high flags: A003 -- rect: left=80 top=300 right=322 bottom=180 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Try It ----- HyperTalk script ----- on mouseUp put Password() end mouseUp -- part 2 (field) -- low flags: 81 -- high flags: 2007 -- rect: left=12 top=26 right=298 bottom=491 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 0 -- font id: 22 -- text size: 10 -- style flags: 0 -- line height: 13 -- part name: Source -- part 3 (button) -- low flags: 00 -- high flags: A003 -- rect: left=299 top=300 right=322 bottom=438 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Show Pascal Source ----- HyperTalk script ----- on mouseUp set the visible of card field 1 to not the visible of card field 1 if the visible of card field 1 is true then set the name of me to "Hide Pascal Source" else set the name of me to "Show Pascal Source" end mouseUp -- part contents for background part 16 ----- text ----- PASSWORD XFCN version 1.0.1 Kevin Calhoun Password behaves in almost the same way as the HyperTalk command "ask password". It differs in that it is capable of distinguishing between upper- and lower-case characters and in that it displays bullets in the ask dialog box instead of the actual password. This is useful if you want to hide what you type from your little brother, your boss, or your archrival in software development. Password returns a number which it derives from the password that's entered. This number can be stored in a field to be compared with the result of a subsequent call to Password if, for example, you want the user to be able to protect data contained in the stack. Given a ne'er-do-well with access to enough CPU time or a whiz at 68000 opcodes with a good disassembler, it's not difficult to imagine that the encryption scheme that Password employs can be broken. Use it only if your little brother, boss, or archrival in software development has better things to do than to hack your stack. Note that the number returned by Password for a particular string is not the same as the number returned for that string by the HyperTalk command "ask password". INVOKING PASSWORD get Password(<"prompt">,) result: a number If parameter 1 is present, it becomes the prompt string that appears in the same place as a question that's passed to the HyperTalk command ask. If parameter 1 is not present, Password uses the prompt, "Please enter your password:". If caseSensitive is TRUE, then Password distinguishes between upper- and lower-case characters when encrypting the password. If it is absent, or it is anything other than TRUE, Password does not distinguish between upper- and lower-case characters. If an error occurs, Password returns a string, the first word of which will be "Error". If the user clicks the Cancel button, Password returns "Cancel". If the user types nothing before clicking the OK button, Password returns 0. My thanks to Jim Matthews for the filter function that handles the bullets. Revision history: 15 March 1989 -- first release. 11 June 1989 -- Changed the way the prompt message is set for compatibility with SuperCard. (No longer use ParamText. Use SetIText instead.) -- part contents for card part 2 ----- text ----- UNIT PasswordUnit; { This source compatible with MPW Pascal 3.0 } { Password XFCN ©1989 by the Trustees of Dartmouth College } { Written by Kevin Calhoun } (* Pascal Password.p Link -m ENTRYPOINT ∂ -o "YourFile" ∂ -rt XFCN=17958 ∂ -sn Main=Password ∂ Password.p.o ∂ "{Libraries}"interface.o ∂ "{PLibraries}"Paslib.o ∂ "{Libraries}"HyperXLib.o *) {$R-} INTERFACE USES Types, Memory, Resources, Dialogs, ToolUtils, OSUtils, HyperXCmd; PROCEDURE Entrypoint (paramPtr : XCmdPtr); IMPLEMENTATION PROCEDURE DoPassword(paramPtr: XCMDPtr); FORWARD; PROCEDURE Entrypoint(paramPtr: XCMDPtr); BEGIN DoPassword(paramPtr); END; FUNCTION GetScreenBitsBounds: Rect; { get screenbits.bounds from the QuickDraw globals } TYPE LongwordPtr = ^LONGINT; BitMapPtr = ^BitMap; CONST screenBitsOffset = -122; CurrentA5 = $904; VAR screenBitsPtr : BitMapPtr; myLongwordPtr : LongwordPtr; BEGIN myLongwordPtr := LongwordPtr(CurrentA5); { myLongwordPtr now points to the pointer to the first QD global } myLongwordPtr := LongwordPtr(myLongwordPtr^); { myLongwordPtr now points to the first QD global } screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset); { screenBitsPtr now points to the screenBits BitMap } GetScreenBitsBounds := screenBitsPtr^.bounds; END; PROCEDURE CenterRectH(var r: Rect; inRect: Rect); var hOffset: INTEGER; BEGIN hOffset := ((inRect.right - inRect.left) - (r.right - r.left)) div 2; OffsetRect(r, -r.left, 0); OffsetRect(r, hOffset, 0); END; FUNCTION Encrypt(s: Str255): LONGINT; var numChars: INTEGER; checkSum: LONGINT; i: INTEGER; BEGIN numChars := LENGTH(s); checkSum := 0; i := 1; while i <= numChars do begin checkSum := checkSum + ORD(s[i]); i := i+1; end; if numChars > 0 then for i := 1 to 10 do checkSum := (checkSum * 16381 + 17) mod 32761 + 1; Encrypt := checkSum; END; PROCEDURE PassReturnValue (paramPtr: XCMDPtr; s : Str255); { set theResult } BEGIN paramPtr^.returnValue := PasToZero(paramPtr, s); END; { signonFilter -- dialog filter for doSignon, hides password } FUNCTION SignonFilter (dp : DialogPtr; VAR theEvent : EventRecord; VAR itemHit : integer) : boolean; CONST nameItem = 3; passwordItem = 4; bs = $08; tab = $09; cr = $0D; enter = $03; larrow = $1C; rarrow = $1D; uparrow = $1E; downarrow = $1F; VAR dpeek : DialogPeek; theChar : char; theStr : Str255; selStart, selEnd : integer; h : Handle; itemType : integer; box : Rect; pwStr : StringPtr; BEGIN pwStr := StringPtr(GetWRefCon(dp)); signonFilter := false; dpeek := DialogPeek(dp); IF ((theEvent.what = keydown) OR (theEvent.what = autoKey)) THEN BEGIN theChar := char(BitAnd(theEvent.message, charCodeMask)); selStart := dpeek^.textH^^.selStart; selEnd := dpeek^.textH^^.selEnd; CASE ord(theChar) OF bs : { Backspace } BEGIN IF selEnd = selStart THEN { back over a character } BEGIN IF selStart > 0 THEN pwStr^ := concat(copy(pwStr^,1, selStart - 1), copy(pwStr^, selStart + 1, length(pwStr^) - selStart)); END ELSE { delete the selection } pwStr^ := concat(copy(pwStr^, 1, selStart), copy(pwStr^, selEnd + 1, length(pwStr^) - selEnd)); END; cr, enter : { Return or Enter -- treat as "OK } BEGIN itemHit := ok; signonFilter := true; END; { cr, enter } tab, uparrow, downarrow, rarrow, larrow : ; { just pass on tabs & arrows } OTHERWISE { "normal" character } BEGIN { remember character, insert a bullet } pwStr^ := concat(copy(pwStr^, 1, selStart), theChar, copy(pwStr^, selEnd + 1, length(pwStr^) - selEnd)); theEvent.message := BitAnd(theEvent.message, $FFFFFF00) + ord('•'); END; { normal character } END; { case ord(theChar) of } END { in password field } ELSE { not in password field -- still check for cr, enter } CASE BitAnd(theEvent.message, charCodeMask) OF cr, enter : BEGIN itemHit := ok; signonFilter := true; END; { cr, enter } OTHERWISE ; END; { case BitAnd } END; { signonFilter } PROCEDURE DoPassword(paramPtr: XCMDPtr); const statTextItem = 3; var dlgTHndl: Handle; hndl: Handle; id: INTEGER; rType: ResType; s: Str255; prompt: Str255; pwStr: Str255; itemHit: INTEGER; d: DialogPtr; kind: INTEGER; r: Rect; saveRect: Rect; saveVis: BOOLEAN; flag: BOOLEAN; myLongint : LONGINT; err: OSErr; BEGIN pwStr := ''; dlgTHndl := GetNamedResource('DLOG', 'Ask'); err := ResError; if (dlgTHndl <> nil) and (err = noErr) then begin HNoPurge(dlgTHndl); GetResInfo(dlgTHndl, id, rType, s); if paramPtr^.paramCount > 0 then ZeroToPas(paramPtr, paramPtr^.params[1]^, prompt) else prompt := 'Please enter your password:'; r := DialogTHndl(dlgTHndl)^^.boundsRect; { get DLOG boundsRect} CenterRectH(r, GetScreenBitsBounds); saveRect := DialogTHndl(dlgTHndl)^^.boundsRect; DialogTHndl(dlgTHndl)^^.boundsRect := r; saveVis := DialogTHndl(dlgTHndl)^^.visible; DialogTHndl(dlgTHndl)^^.visible := FALSE; d := GetNewDialog(id, nil, POINTER(-1)); GetDItem(d, statTextItem, kind, hndl, r); IF (kind MOD itemDisable = statText) THEN SetIText(hndl,prompt); SetWRefCon(d, LONGINT(@pwStr)); ShowWindow(d); BringToFront(d); SetPort(d); GetDItem(d, 1, kind, hndl, r); InsetRect(r,-4,-4); PenSize(3,3); FrameRoundRect(r,16,16); PenSize(1,1); repeat ModalDialog(@SignonFilter, itemHit); until (itemHit = OK) or (itemHit = Cancel); DialogTHndl(dlgTHndl)^^.boundsRect := saveRect; DialogTHndl(dlgTHndl)^^.visible := saveVis; HPurge(dlgTHndl); DisposDialog(d); if itemHit = Cancel then PassReturnValue(paramPtr, 'Cancel') else begin if paramPtr^.paramCount > 1 then begin ZeroToPas(paramPtr, paramPtr^.params[2]^, s); flag := FALSE; flag := StrToBool(paramPtr, s); if (paramPtr^.result <> noErr) or not flag then UprString(pwStr,TRUE); end else UprString(pwStr,TRUE); myLongint := Encrypt(pwStr); NumToStr(paramPtr, myLongint, s); PassReturnValue(paramptr, s); end; end else begin NumToStr(paramPtr, err, s); PassReturnValue(paramPtr, CONCAT('Error ', s)); end; END; END.